home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
eco30603.zip
/
ECO30603.LZH
/
STRINGZ.INC
< prev
Wrap
Text File
|
1993-03-08
|
3KB
|
120 lines
procedure __xtmovmem;
type
localdesctable = record
seglimit : word;
loword : word;
hibyte : byte;
dataaccess : byte;
reserved : word
end;
globaldesctable = record
dummy : localdesctable;
local : localdesctable;
source : localdesctable;
target : localdesctable;
bioscs : localdesctable;
stack : localdesctable
end;
var
gdt : globaldesctable;
dosads : _xads;
reg : registers;
tempseg : word;
tempofs : word;
temp : longint;
begin
if false then begin errorcode := 4; exit end;
fillchar(gdt, sizeof(gdt), #0);
tempseg := _vectoraddr(memptr)._seg;
tempofs := _vectoraddr(memptr)._ofs;
temp := (16 * longint(tempseg)) + longint(tempofs);
with dosads do begin
_hibyte := byte((temp div 65536) and $ff);
_loword := word((temp - (65536 * longint(_hibyte))) and $ffff)
end;
with gdt do begin
if (toext) then begin
source.hibyte := dosads._hibyte;
source.loword := dosads._loword;
target.hibyte := extads._hibyte;
target.loword := extads._loword
end else begin
source.hibyte := extads._hibyte;
source.loword := extads._loword;
target.hibyte := dosads._hibyte;
target.loword := dosads._loword
end;
source.seglimit := nowords shl 2;
target.seglimit := nowords shl 2;
source.dataaccess := $93;
target.dataaccess := $93
end;
with reg do begin
ax := $8700;
cx := nowords;
es := seg(gdt);
si := ofs(gdt);
intr($15, reg);
if ((flags and fcarry) <> 0) then errorcode := ah else errorcode := 0
end
end;
procedure __xtmovmem(
memptr: pointer; extads: _xads; nowords: word;
toext: boolean; var errorcode: word
);
function __rem_str(s:string; target:string):string;
function __nxtwrd(var s : string):string;
function __strtok(var s : string; delimiters:string):string;
function __rem_str(s:string; target:string):string;
var
slen : byte absolute s;
tlen : byte absolute target;
p : integer;
begin
p := pos(target,s);
__rem_str := s;
if (p <> 0) then begin delete(s,p,tlen); __rem_str := s; end;
end; {end function substr}
function __nxtwrd(var s : string):string;
var p : byte;
begin
__nxtwrd := '';
s := __cvtstr(s, _rem_lead_white_str + _rem_trail_white_str);
if length(s)=0 then exit;
p := pos(' ',s);
if p > 0 then begin __nxtwrd := copy(s,1,p-1); delete(s,1,p) end else begin
__nxtwrd := s; s:= '';
end;
end;
function __strtok(var s : string; delimiters:string):string;
var
p,b : byte;
vkeys : set of char;
begin
__strtok := '';
s := __cvtstr(s, _rem_lead_white_str + _rem_trail_white_str);
if length(s)=0 then exit;
vkeys := [];
for p := 1 to length(delimiters) do vkeys := vkeys + [delimiters[p]];
if s[1] in vkeys then delete(s,1,1);
for p := 1 to length(s) do begin
if s[p] in vkeys then begin
__strtok := copy(s,1,p-1); delete(s,1,p); exit;
end;
end;
__strtok := s;
s := '';
end;